Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyBufferedIO.p

Text File | 1996-06-01 | 8.6 KB | 330 lines | [TEXT/CWIE]

unit MyBufferedIO;

interface

    uses
        Types;

    type
        BufferedWriteRecord = record
            size: longint;
            inbuf: longint;
            refnum: integer;
            data: longint;
        end;
        BufferedWriteRecordPtr = ^BufferedWriteRecord;

    type
        BufferedReadRecord = record
                size: longint;
                inbuf: longint;
                buf_pos: longint;
                refnum: integer;
                file_length: longint;
                eof: Boolean;
                data: longint;
            end;
        BufferedReadRecordPtr = ^BufferedReadRecord;


    function BufferedWriteCreate(var brp: BufferedWriteRecordPtr; refnum: integer; size: longint): OSErr;
    function BufferedWriteDestroy(var brp: BufferedWriteRecordPtr): OSErr;
    function BufferedWriteFlush(brp: BufferedWriteRecordPtr): OSErr;
    function BufferedWrite(brp: BufferedWriteRecordPtr; data: Ptr; len: longint): OSErr;
    function BufferedWriteSeek (brp: BufferedWriteRecordPtr; posMode: integer; seek: longint): OSErr;
    function BufferedWriteGetFPos (brp: BufferedWriteRecordPtr; var seek: longint): OSErr;

    function BufferedReadCreate (var brp: BufferedReadRecordPtr; refnum: integer; size: longint): OSErr;
    function BufferedReadDestroy(var brp: BufferedReadRecordPtr): OSErr;
    function BufferedRead (brp: BufferedReadRecordPtr; data: Ptr; var size: longint): OSErr;
    function BufferedReadStrict (brp: BufferedReadRecordPtr; data: Ptr; size: longint): OSErr;
    function BufferedReadSeek (brp: BufferedReadRecordPtr; posMode: integer; seek: longint): OSErr;
    function BufferedReadGetFPos (brp: BufferedReadRecordPtr; var seek: longint): OSErr;

implementation

    uses
        Files, Errors,
        MyMemory, MyMathUtils, QLowLevel, MyAssertions;

{$SETC buffer := 1 }

    function BufferedWriteCreate(var brp: BufferedWriteRecordPtr; refnum: integer; size: longint): OSErr;
        var
            err: OSErr;
    begin
        if size < 1000 then begin
            size := 1000;
        end;
        err := MNewPtr(brp, size);
        if err = noErr then begin
            brp^.size := size - SizeOf(BufferedWriteRecord);
            brp^.inbuf := 0;
            brp^.refnum := refnum;
        end;
        BufferedWriteCreate := err;
    end;

    function BufferedWriteDestroy(var brp: BufferedWriteRecordPtr): OSErr;
        var
            err: OSErr;
    begin
        err := BufferedWriteFlush(brp);
        MDisposePtr(brp);
        BufferedWriteDestroy := err;
    end;

    function BufferedWriteFlush(brp: BufferedWriteRecordPtr): OSErr;
        var
            err: OSErr;
    begin
        err := noErr;
        if brp^.inbuf > 0 then begin
            err := FSWrite(brp^.refnum, brp^.inbuf, @brp^.data);
            brp^.inbuf := 0;
        end;
        BufferedWriteFlush := err;
    end;

    function BufferedWrite(brp: BufferedWriteRecordPtr; data: Ptr; len: longint): OSErr;
        var
            err: OSErr;
    begin
        err := noErr;
        if brp^.inbuf + len >= brp^.size then begin
            err := BufferedWriteFlush(brp);
            if (err = noErr) & (len >= brp^.size) then begin
                err := FSWrite(brp^.refnum, len, data);
                len := 0;
            end;
        end;
        if (err = noErr) & (len > 0) then begin
            BlockMoveData(data, AddPtrLong(@brp^.data, brp^.inbuf), len);
            brp^.inbuf := brp^.inbuf + len;
        end;
        BufferedWrite := err;
    end;

    function BufferedWriteSeek (brp: BufferedWriteRecordPtr; posMode: integer; seek: longint): OSErr;
        var
            err: OSErr;
    begin
        err := BufferedWriteFlush(brp);
        if err = noErr then begin
            err := SetFPos(brp^.refnum, posMode, seek);
        end;
        BufferedWriteSeek := err;
    end;

    function BufferedWriteGetFPos (brp: BufferedWriteRecordPtr; var seek: longint): OSErr;
        var
            err: OSErr;
    begin
        err := GetFPos(brp^.refnum, seek);
        seek := seek + brp^.inbuf;
        BufferedWriteGetFPos := err;
    end;

    function BufferedReadCreate (var brp: BufferedReadRecordPtr; refnum: integer; size: longint): OSErr;
        var
            err: OSErr;
            flen: longint;
    begin
        err := GetEOF(refnum, flen);
        if err = noErr then begin
            if size < 1000 then begin
                size := 1000;
            end;
            err := MNewPtr(brp, size);
            if err = noErr then begin
                brp^.size := size - SizeOf(BufferedReadRecord);
                brp^.inbuf := 0;
                brp^.refnum := refnum;
                brp^.file_length := flen;
                brp^.buf_pos := 0;
                brp^.eof := false;
            end;
        end;
        BufferedReadCreate := err;
    end;

    function BufferedReadDestroy(var brp: BufferedReadRecordPtr): OSErr;
    begin
        MDisposePtr(brp);
        BufferedReadDestroy := noErr;
    end;

    function FillBuffer(brp: BufferedReadRecordPtr): OSErr;
        var
            err: OSErr;
            count: longint;
    begin
        err := noErr;
        if brp^.buf_pos < brp^.inbuf then begin
            BlockMoveData(AddPtrLong(@brp^.data, brp^.buf_pos), @brp^.data, brp^.inbuf - brp^.buf_pos);
            brp^.inbuf := brp^.inbuf - brp^.buf_pos;
        end else begin
            brp^.inbuf := 0;
        end;
        brp^.buf_pos := 0;
        if not brp^.eof and (brp^.inbuf < brp^.size) then begin
            count := brp^.size - brp^.inbuf;
            err := FSRead(brp^.refnum, count, AddPtrLong(@brp^.data, brp^.inbuf));
            brp^.eof := err = eofErr;
            if err = eofErr then begin
                err := noErr;
            end;
            brp^.inbuf := brp^.inbuf + count;
        end;
        FillBuffer := err;
    end;

    function BufferedRead (brp: BufferedReadRecordPtr; data: Ptr; var size: longint): OSErr;
        var
            err: OSErr;
            count, retsize, inbuffer: longint;
    begin
{$IFC buffer}
        err := noErr;
        retsize := 0;
        while (retsize < size) & (err = noErr) do begin
            count := brp^.inbuf - brp^.buf_pos;
            if count > 0 then begin
                inbuffer := Min(size - retsize, count);
                BlockMoveData(AddPtrLong(@brp^.data, brp^.buf_pos), AddPtrLong(data, retsize), inbuffer);
                retsize := retsize + inbuffer;
                brp^.buf_pos := brp^.buf_pos + inbuffer;
            end;
            if retsize < size then begin
                Assert(brp^.inbuf = brp^.buf_pos);
                if not brp^.eof then begin
                    if size - retsize > brp^.size then begin
                        count := size - retsize;
                        err := FSRead(brp^.refnum, count, AddPtrLong(data, retsize));
                        brp^.eof := err = eofErr;
                        if err = eofErr then begin
                            err := noErr;
                        end;
                        retsize := retsize + count;
                        leave;
                    end else begin
                        err := FillBuffer(brp);
                        if brp^.inbuf = 0 then begin
                            leave;
                        end;
                    end;
                end else begin
                    leave;
                end;
            end;
        end;
        if (err = noErr) & (size > 0) & (retsize = 0) then begin
            err := eofErr;
        end;
        size := retsize;
{$ELSEC}
        err := FSRead(brp^.refnum, size, data);
{$ENDC}
        BufferedRead := err;
    end;

    function BufferedReadStrict (brp: BufferedReadRecordPtr; data: Ptr; size: longint): OSErr;
        var
            err: OSErr;
            oldsize: longint;
    begin
        oldsize := size;
        err := BufferedRead(brp, data, size);
        if (err = noErr) & (oldsize <> size) then begin
            err := eofErr;
        end;
        BufferedReadStrict := err;
    end;

    function BufferedReadSeek (brp: BufferedReadRecordPtr; posMode: integer; seek: longint): OSErr;
        var
            err: OSErr;
    begin
{$IFC buffer}
        if (posMode = fsFromMark) then begin
            if (-brp^.buf_pos <= seek) & (seek <= (brp^.inbuf - brp^.buf_pos)) then begin
                brp^.buf_pos := brp^.buf_pos + seek;
                err := noErr;
            end else begin
                err := SetFPos(brp^.refnum, posMode, seek - (brp^.inbuf - brp^.buf_pos) );
                brp^.inbuf := 0;
                brp^.buf_pos := 0;
                brp^.eof := false;
            end;
        end else begin
            err := SetFPos(brp^.refnum, posMode, seek);
            brp^.inbuf := 0;
            brp^.buf_pos := 0;
            brp^.eof := false;
        end;
{$ELSEC}
        err := SetFPos(brp^.refnum, posMode, seek);
{$ENDC}
        BufferedReadSeek := err;
    end;

    function BufferedReadGetFPos (brp: BufferedReadRecordPtr; var seek: longint): OSErr;
        var
            err: OSErr;
    begin
        err := GetFPos(brp^.refnum, seek);
{$IFC buffer}
        seek := seek - (brp^.inbuf - brp^.buf_pos);
{$ENDC}
        BufferedReadGetFPos := err;
    end;

end.

    var
        err, junk: OSErr;
        src, dst: FSSpec;
        srn, drn: integer;
        srcbrp: BufferedReadRecordPtr;
        dstbrp: BufferedWriteRecordPtr;
        buffer: packed array[1..10000] of Byte;
        count: longint;
begin
    junk := FSMakeFSSpec(0, 0, 'Zany:WordCounts.hqx', src);
    junk := FSMakeFSSpec(0, 0, 'Zany:OutputFile', dst);
    junk := FSpDelete(dst);
    junk := FSpCreate(dst, '????', 'TEXT', 0);
    err := FSpOpenDF(src, fsRdPerm, srn);
    writeln('FSpOpenDF ', err);
    if err = noErr then begin
        err := BufferedReadCreate(srcbrp, srn, 8000);
        writeln('BufferedReadCreate ', err);
        if err = noErr then begin
            err := FSpOpenDF(dst, fsWrPerm, drn);
            writeln('FSpOpenDF ', err);
            if err = noErr then begin
                err := BufferedWriteCreate(dstbrp, drn, 8000);
                writeln('BufferedWriteCreate ', err);
                if err = noErr then begin
                    while err = noErr do begin
                        count := SizeOf(buffer);
                        err := BufferedRead(srcbrp, @buffer, count);
                        if err = noErr then begin
                            err := BufferedWrite(dstbrp, @buffer, count);
                        end;
                    end;
                    writeln(err);
                    err := BufferedWriteDestroy(dstbrp);
                    writeln('BufferedWriteDestroy ', err);
                end;
                err := FSClose(drn);
                writeln('FSClose ', err);
            end;
            err := BufferedReadDestroy(srcbrp);
            writeln('BufferedReadDestroy ', err);
        end;
        junk := FSClose(srn);
        writeln('FSClose ', err);
    end;
end.